home *** CD-ROM | disk | FTP | other *** search
/ PC Open 100 / PC Open 100 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / POPFile / Loader.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-25  |  25.8 KB  |  834 lines
  1. package POPFile::Loader;
  2.  
  3. # ---------------------------------------------------------------------------------------------
  4. #
  5. # Loader.pm --- API for loading POPFile loadable modules and encapsulating POPFile application
  6. #               tasks
  7. #
  8. # Subroutine names beginning with CORE indicate a subroutine designed for exclusive use of
  9. # POPFile's core application (popfile.pl).
  10. #
  11. # Subroutines not so marked are suitable for use by POPFile-based utilities to assist in loading
  12. # and executing modules
  13. #
  14. # Copyright (c) 2001-2003 John Graham-Cumming
  15. #
  16. #   This file is part of POPFile
  17. #
  18. #   POPFile is free software; you can redistribute it and/or modify
  19. #   it under the terms of the GNU General Public License as published by
  20. #   the Free Software Foundation; either version 2 of the License, or
  21. #   (at your option) any later version.
  22. #
  23. #   POPFile is distributed in the hope that it will be useful,
  24. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  25. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  26. #   GNU General Public License for more details.
  27. #
  28. #   You should have received a copy of the GNU General Public License
  29. #   along with POPFile; if not, write to the Free Software
  30. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  31. #
  32. #   Modified by     Sam Schinke (sschinke@users.sourceforge.net)
  33. #
  34. # ---------------------------------------------------------------------------------------------
  35.  
  36. #----------------------------------------------------------------------------------------------
  37. # new
  38. #
  39. #   Class new() function
  40. #----------------------------------------------------------------------------
  41. sub new
  42. {
  43.     my $type = shift;
  44.     my $self;
  45.  
  46.     # The POPFile classes are stored by reference in the components hash, the top level key is
  47.     # the type of the component (see CORE_load_directory_modules) and then the name of the
  48.     # component derived from calls to each loadable modules name() method and which points to
  49.     # the actual module
  50.  
  51.     $self->{components__} = {};
  52.  
  53.     # A handy boolean that tells us whether we are alive or not.  When this is set to 1 then the
  54.     # proxy works normally, when set to 0 (typically by the aborting() function called from a signal)
  55.     # then we will terminate gracefully
  56.  
  57.     $self->{alive__} = 1;
  58.  
  59.     # This must be 1 for POPFile::Loader to create any output on STDOUT
  60.  
  61.     $self->{debug__} = 1;
  62.  
  63.     # This stuff lets us do some things in a way that tolerates some window-isms
  64.  
  65.     $self->{on_windows__} = 0;
  66.  
  67.     if ( $^O eq 'MSWin32' ) {
  68.         require v5.8.0;
  69.         $self->{on_windows__} = 1;
  70.     }
  71.  
  72.     # See CORE_loader_init below for an explanation of these
  73.  
  74.     $self->{aborting__}     = '';
  75.     $self->{pipeready__}    = '';
  76.     $self->{forker__}       = '';
  77.     $self->{reaper__}       = '';
  78.  
  79.     # POPFile's version number as individual numbers and as
  80.     # string
  81.  
  82.     $self->{major_version__}  = '?';
  83.     $self->{minor_version__}  = '?';
  84.     $self->{build_version__}  = '?';
  85.     $self->{version_string__} = '';
  86.  
  87.     # Where POPFile is installed
  88.  
  89.     $self->{popfile_root__} = './';
  90.  
  91.     bless $self, $type;
  92.  
  93.     return $self;
  94. }
  95.  
  96. #---------------------------------------------------------------------------------------------
  97. #
  98. # CORE_loader_init
  99. #
  100. # Initialize things only needed in CORE
  101. #
  102. #---------------------------------------------------------------------------------------------
  103. sub CORE_loader_init
  104. {
  105.     my ( $self ) = @_;
  106.  
  107.     if ( defined( $ENV{POPFILE_ROOT} ) ) {
  108.         $self->{popfile_root__} = $ENV{POPFILE_ROOT};
  109.     }
  110.  
  111.     # These anonymous subroutine references allow us to call these important
  112.     # functions from anywhere using the reference, granting internal access
  113.     # to $self, without exposing $self to the unwashed. No reference to
  114.     # POPFile::Loader is needed by the caller
  115.  
  116.     $self->{aborting__} = sub { $self->CORE_aborting(@_) };
  117.     $self->{pipeready__} = sub { $self->pipeready(@_) };
  118.     $self->{forker__} = sub { $self->CORE_forker(@_) };
  119.     $self->{reaper__} = sub { $self->CORE_reaper(@_) };
  120.  
  121.     # See if there's a file named popfile_version that contains the
  122.     # POPFile version number
  123.  
  124.     my $version_file = $self->root_path__( 'POPFile/popfile_version' );
  125.  
  126.     if ( -e $version_file ) {
  127.         open VER, "<$version_file";
  128.         my $major = int(<VER>);
  129.         my $minor = int(<VER>);
  130.         my $rev   = int(<VER>);
  131.         close VER;
  132.         $self->CORE_version( $major, $minor, $rev );
  133.     }
  134.  
  135.     print "\nPOPFile Engine loading\n" if $self->{debug__};
  136. }
  137.  
  138. #---------------------------------------------------------------------------------------------
  139. #
  140. # CORE_aborting
  141. #
  142. # Called if we are going to be aborted or are being asked to abort our operation. Sets the
  143. # alive flag to 0 that will cause us to abort at the next convenient moment
  144. #
  145. #---------------------------------------------------------------------------------------------
  146. sub CORE_aborting
  147. {
  148.     my ( $self ) = @_;
  149.  
  150.     $self->{alive__} = 0;
  151.     foreach my $type (keys %{$self->{components__}}) {
  152.         foreach my $name (keys %{$self->{components__}{$type}}) {
  153.             $self->{components__}{$type}{$name}->alive(0);
  154.             $self->{components__}{$type}{$name}->stop();
  155.         }
  156.     }
  157. }
  158.  
  159. #---------------------------------------------------------------------------------------------
  160. #
  161. # pipeready
  162. #
  163. # Returns 1 if there is data available to be read on the passed in pipe handle
  164. #
  165. # $pipe        Pipe handle
  166. #
  167. #---------------------------------------------------------------------------------------------
  168. sub pipeready
  169. {
  170.     my ( $self, $pipe ) = @_;
  171.  
  172.     # Check that the $pipe is still a valid handle
  173.  
  174.     if ( !defined( $pipe ) ) {
  175.         return 0;
  176.     }
  177.  
  178.     if ( $self->{on_windows__} ) {
  179.  
  180.         # I am NOT doing a select() here because that does not work
  181.         # on Perl running on Windows.  -s returns the "size" of the file
  182.         # (in this case a pipe) and will be non-zero if there is data to read
  183.  
  184.         return ( ( -s $pipe ) > 0 );
  185.     } else {
  186.  
  187.         # Here I do a select because we are not running on Windows where
  188.         # you can't select() on a pipe
  189.  
  190.         my $rin = '';
  191.         vec( $rin, fileno( $pipe ), 1 ) = 1;
  192.         my $ready = select( $rin, undef, undef, 0.01 );
  193.         return ( $ready > 0 );
  194.     }
  195. }
  196.  
  197. #---------------------------------------------------------------------------------------------
  198. #
  199. # CORE_reaper
  200. #
  201. # Called if we get SIGCHLD and asks each module to do whatever reaping is needed
  202. #
  203. #---------------------------------------------------------------------------------------------
  204. sub CORE_reaper
  205. {
  206.     my ( $self ) = @_;
  207.  
  208.     foreach my $type (keys %{$self->{components__}}) {
  209.         foreach my $name (keys %{$self->{components__}{$type}}) {
  210.             $self->{components__}{$type}{$name}->reaper();
  211.         }
  212.     }
  213.  
  214.     $SIG{CHLD} = $self->{reaper__};
  215. }
  216.  
  217. #---------------------------------------------------------------------------------------------
  218. #
  219. # CORE_forker
  220. #
  221. # Called to fork POPFile.  Calls every module's forked function in the child process to give
  222. # then a chance to clean up
  223. #
  224. # Returns the return value from fork() and a file handle that form a pipe in the
  225. # direction child to parent.  There is no need to close the file handles that are unused as
  226. # would normally be the case with a pipe and fork as forker takes care that in each process
  227. # only one file handle is open (be it the reader or the writer)
  228. #
  229. #---------------------------------------------------------------------------------------------
  230. sub CORE_forker
  231. {
  232.     my ( $self ) = @_;
  233.  
  234.     # Tell all the modules that a fork is about to happen
  235.  
  236.     foreach my $type (keys %{$self->{components__}}) {
  237.         foreach my $name (keys %{$self->{components__}{$type}}) {
  238.             $self->{components__}{$type}{$name}->prefork();
  239.         }
  240.     }
  241.  
  242.     # Create the pipe that will be used to send data from the child to the parent process,
  243.     # $writer will be returned to the child process and $reader to the parent process
  244.  
  245.     pipe my $reader, my $writer;
  246.     my $pid = fork();
  247.  
  248.     # If fork() returns an undefined value then we failed to fork and are
  249.     # in serious trouble (probably out of resources) so we return undef
  250.  
  251.     if ( !defined( $pid ) ) {
  252.         close $reader;
  253.         close $writer;
  254.         return (undef, undef);
  255.     }
  256.  
  257.     # If fork returns a PID of 0 then we are in the child process so close the
  258.     # reading pipe file handle, inform all modules that are fork has occurred and
  259.     # then return 0 as the PID so that the caller knows that we are in the child
  260.  
  261.     if ( $pid == 0 ) {
  262.           foreach my $type (keys %{$self->{components__}}) {
  263.                foreach my $name (keys %{$self->{components__}{$type}}) {
  264.                  $self->{components__}{$type}{$name}->forked();
  265.               }
  266.         }
  267.  
  268.         close $reader;
  269.  
  270.         # Set autoflush on the write handle so that output goes straight through
  271.         # to the parent without buffering it until the socket closes
  272.  
  273.         use IO::Handle;
  274.         $writer->autoflush(1);
  275.  
  276.         return (0, $writer);
  277.     }
  278.  
  279.     # Reach here because we are in the parent process, close out the writer pipe
  280.     # file handle and return our PID (non-zero) indicating that this is the parent
  281.     # process
  282.  
  283.     foreach my $type (keys %{$self->{components__}}) {
  284.         foreach my $name (keys %{$self->{components__}{$type}}) {
  285.             $self->{components__}{$type}{$name}->postfork();
  286.         }
  287.     }
  288.  
  289.     close $writer;
  290.     return ($pid, $reader);
  291. }
  292.  
  293. #---------------------------------------------------------------------------------------------
  294. #
  295. # CORE_load_directory_modules
  296. #
  297. # Called to load all the POPFile Loadable Modules (implemented as .pm files with special
  298. # comment on first line) in a specific subdirectory and loads them into a structured
  299. # components hash
  300. #
  301. # $directory        The directory to search for loadable modules
  302. # $type             The 'type' of module being loaded (e.g. proxy, core, ui) which is used
  303. #                   when fixing up references between modules (e.g. proxy modules all need
  304. #                   access to the classifier module) and for structuring components hash
  305. #
  306. #---------------------------------------------------------------------------------------------
  307. sub CORE_load_directory_modules
  308. {
  309.     my ( $self, $directory, $type ) = @_;
  310.  
  311.     print "\n         {$type:" if $self->{debug__};
  312.  
  313.     # Look for all the .pm files in named directory and then see which of them
  314.     # are POPFile modules indicated by the first line of the file being and
  315.     # comment (# POPFILE LOADABLE MODULE) and load that module into the %{$self->{components__}}
  316.     # hash getting the name from the module by calling name()
  317.  
  318.     opendir MODULES, $self->root_path__( $directory );
  319.  
  320.     while ( my $entry = readdir MODULES ) {
  321.         if ( $entry =~ /\.pm$/ ) {
  322.             $self->CORE_load_module( "$directory/$entry", $type );
  323.     }
  324.     }
  325.  
  326.     closedir MODULES;
  327.  
  328.     print '} ' if $self->{debug__};
  329. }
  330.  
  331. #---------------------------------------------------------------------------------------------
  332. #
  333. # CORE_load_module
  334. #
  335. # Called to load a single POPFile Loadable Module (implemented as .pm files with special
  336. # comment on first line) and add it to the components hash.
  337. #
  338. # Returns a handle to the module
  339. #
  340. # $module           The path of the module to load
  341. # $type             The 'type' of module being loaded (e.g. proxy, core, ui)
  342. #
  343. #---------------------------------------------------------------------------------------------
  344. sub CORE_load_module
  345. {
  346.     my ( $self, $module, $type ) = @_;
  347.  
  348.     my $mod = $self->load_module_($module);
  349.  
  350.     if ( defined( $mod ) ) {
  351.         my $name = $mod->name();
  352.         print " $name" if $self->{debug__};
  353.         $self->{components__}{$type}{$name} = $mod;
  354.     }
  355.     return $mod;
  356. }
  357.  
  358. #---------------------------------------------------------------------------------------------
  359. #
  360. # load_module_
  361. #
  362. # Called to load a single POPFile Loadable Module (implemented as .pm files with special
  363. # comment on first line. Returns a handle to the module, undef if the module failed to load.
  364. # No internal side-effects.
  365. #
  366. # $module           The path of the module to load
  367. #
  368. #---------------------------------------------------------------------------------------------
  369. sub load_module_
  370. {
  371.     my ( $self, $module ) = @_;
  372.  
  373.     my $mod;
  374.  
  375.     if ( open MODULE, '<' . $self->root_path__( $module ) ) {
  376.         my $first = <MODULE>;
  377.         close MODULE;
  378.  
  379.         if ( $first =~ /^# POPFILE LOADABLE MODULE/ ) {
  380.             require $module;
  381.  
  382.             $module =~ s/\//::/;
  383.             $module =~ s/\.pm//;
  384.  
  385.             $mod = $module->new();
  386.         }
  387.     }
  388.     return $mod;
  389. }
  390.  
  391. #---------------------------------------------------------------------------------------------
  392. #
  393. # CORE_signals
  394. #
  395. # Sets signals to ensure that POPFile handles OS and IPC events
  396. #
  397. # TODO: Figure out why windows POPFile doesn't seem to get SIGTERM when windows shuts down
  398. #
  399. #---------------------------------------------------------------------------------------------
  400. sub CORE_signals
  401. {
  402.     my ( $self ) = @_;
  403.  
  404.     # Redefine POPFile's signals
  405.  
  406.     $SIG{QUIT}  = $self->{aborting__};
  407.     $SIG{ABRT}  = $self->{aborting__};
  408.     $SIG{KILL}  = $self->{aborting__};
  409.     $SIG{STOP}  = $self->{aborting__};
  410.     $SIG{TERM}  = $self->{aborting__};
  411.     $SIG{INT}   = $self->{aborting__};
  412.  
  413.     # Yuck.  On Windows SIGCHLD isn't calling the reaper under ActiveState 5.8.0
  414.     # so we detect Windows and ignore SIGCHLD and call the reaper code below
  415.  
  416.     $SIG{CHLD}  = $self->{on_windows__}?'IGNORE':$self->{reaper__};
  417.  
  418.     # I've seen spurious ALRM signals happen on Windows so here we for safety
  419.     # say that we want to ignore them
  420.  
  421.     $SIG{ALRM}  = 'IGNORE';
  422.  
  423.     return $SIG;
  424. }
  425.  
  426. #---------------------------------------------------------------------------------------------
  427. #
  428. # CORE_platform_
  429. #
  430. # Loads POPFile's platform-specific code
  431. #
  432. #---------------------------------------------------------------------------------------------
  433. sub CORE_platform_
  434. {
  435.     my ( $self ) = @_;
  436.  
  437.     # Look for a module called Platform::<platform> where <platform> is the value of $^O
  438.     # and if it exists then load it as a component of POPFile.  IN this way we can have
  439.     # platform specific code (or not) encapsulated.  Note that such a module needs to be
  440.     # a POPFile Loadable Module and a subclass of POPFile::Module to operate correctly
  441.  
  442.     my $platform = $^O;
  443.  
  444.     if ( -e $self->root_path__( "Platform/$platform.pm" ) ) {
  445.         print "\n         {core:" if $self->{debug__};
  446.  
  447.         $self->CORE_load_module( "Platform/$platform.pm",'core');
  448.  
  449.         print "}" if $self->{debug__};
  450.     }
  451. }
  452.  
  453. #---------------------------------------------------------------------------------------------
  454. #
  455. # CORE_load
  456. #
  457. # Loads POPFile's modules
  458. #
  459. #---------------------------------------------------------------------------------------------
  460. sub CORE_load
  461. {
  462.     my ( $self ) = @_;
  463.  
  464.     # Create the main objects that form the core of POPFile.  Consists of the configuration
  465.     # modules, the classifier, the UI (currently HTML based), and the POP3 proxy.
  466.  
  467.     print "\n    Loading... " if $self->{debug__};
  468.  
  469.     # Do our platform-specific stuff
  470.     $self->CORE_platform_();
  471.  
  472.     # populate our components hash
  473.     $self->CORE_load_directory_modules( 'POPFile',    'core'       );
  474.     $self->CORE_load_directory_modules( 'Classifier', 'classifier' );
  475.     $self->CORE_load_directory_modules( 'UI',         'interface' );
  476.     $self->CORE_load_directory_modules( 'Proxy',      'proxy'      );
  477. }
  478.  
  479. #---------------------------------------------------------------------------------------------
  480. #
  481. # CORE_link_components
  482. #
  483. # Links POPFile's modules together to allow them to make use of each-other as objects
  484. #
  485. #---------------------------------------------------------------------------------------------
  486. sub CORE_link_components
  487. {
  488.     my ( $self ) = @_;
  489.  
  490.     print "\n\nPOPFile Engine $self->{version_string__} starting" if $self->{debug__};
  491.  
  492.     # Link each of the main objects with the configuration object so that they can set their
  493.     # default parameters all or them also get access to the logger, version, and message-queue
  494.  
  495.     foreach my $type (keys %{$self->{components__}}) {
  496.         foreach my $name (keys %{$self->{components__}{$type}}) {
  497.             $self->{components__}{$type}{$name}->version(       scalar($self->CORE_version())                    );
  498.             $self->{components__}{$type}{$name}->configuration( $self->{components__}{core}{config} );
  499.             $self->{components__}{$type}{$name}->logger(        $self->{components__}{core}{logger} ) if ( $name ne 'logger' );
  500.             $self->{components__}{$type}{$name}->mq(            $self->{components__}{core}{mq}     );
  501.         }
  502.     }
  503.  
  504.     # All interface components need access to the classifier
  505.  
  506.     foreach my $name (keys %{$self->{components__}{interface}}) {
  507.         $self->{components__}{interface}{$name}->classifier( $self->{components__}{classifier}{bayes} );
  508.     }
  509.  
  510.     foreach my $name (keys %{$self->{components__}{proxy}}) {
  511.         $self->{components__}{proxy}{$name}->classifier( $self->{components__}{classifier}{bayes} );
  512.     }
  513.  
  514.     # TODO Clean this up so that the Loader doesn't have to know so much about
  515.     # Bayes.
  516.  
  517.     $self->{components__}{classifier}{bayes}->{parser__}->mangle(
  518.         $self->{components__}{classifier}{wordmangle} );
  519. }
  520.  
  521. #---------------------------------------------------------------------------------------------
  522. #
  523. # CORE_initialize
  524. #
  525. # Loops across POPFile's modules and initializes them
  526. #
  527. #---------------------------------------------------------------------------------------------
  528. sub CORE_initialize
  529. {
  530.     my ( $self ) = @_;
  531.  
  532.     print "\n\n    Initializing... " if $self->{debug__};
  533.  
  534.     # Tell each module to initialize itself
  535.  
  536.     foreach my $type (keys %{$self->{components__}}) {
  537.         print "\n         {$type:" if $self->{debug__};
  538.         foreach my $name (keys %{$self->{components__}{$type}}) {
  539.             print " $name" if $self->{debug__};
  540.             flush STDOUT;
  541.  
  542.             my $code = $self->{components__}{$type}{$name}->initialize();
  543.  
  544.             if ( $code == 0 ) {
  545.                 die "Failed to start while initializing the $name module";
  546.             }
  547.  
  548.             if ( $code == 1 ) {
  549.                  $self->{components__}{$type}{$name}->alive(     1 );
  550.  
  551.                  $self->{components__}{$type}{$name}->forker(    $self->{forker__} );
  552.                  $self->{components__}{$type}{$name}->pipeready( $self->{pipeready__} );
  553.         }
  554.         }
  555.         print '} ' if $self->{debug__};
  556.     }
  557.     print "\n";
  558. }
  559.  
  560. #---------------------------------------------------------------------------------------------
  561. #
  562. # CORE_config
  563. #
  564. # Loads POPFile's configuration and command-line settings
  565. #
  566. #---------------------------------------------------------------------------------------------
  567. sub CORE_config
  568. {
  569.     my ( $self ) = @_;
  570.  
  571.     # Load the configuration from disk and then apply any command line
  572.     # changes that override the saved configuration
  573.  
  574.     $self->{components__}{core}{config}->load_configuration();
  575.     return $self->{components__}{core}{config}->parse_command_line();
  576. }
  577.  
  578. #---------------------------------------------------------------------------------------------
  579. #
  580. # CORE_start
  581. #
  582. # Loops across POPFile's modules and starts them
  583. #
  584. #---------------------------------------------------------------------------------------------
  585. sub CORE_start
  586. {
  587.     my ( $self ) = @_;
  588.  
  589.     print "\n    Starting...     " if $self->{debug__};
  590.  
  591.     # Now that the configuration is set tell each module to begin operation
  592.  
  593.     foreach my $type (keys %{$self->{components__}}) {
  594.         print "\n         {$type:" if $self->{debug__};
  595.         foreach my $name (keys %{$self->{components__}{$type}}) {
  596.             my $code = $self->{components__}{$type}{$name}->start();
  597.  
  598.             if ( $code == 0 ) {
  599.                 die "Failed to start while starting the $name module";
  600.             }
  601.  
  602.             # If the module said that it didn't want to be loaded then
  603.             # unload it.
  604.  
  605.             if ( $code == 2 ) {
  606.                 delete $self->{components__}{$type}{$name};
  607.         } else {
  608.                 print " $name" if $self->{debug__};
  609.                 flush STDOUT;
  610.             }
  611.         }
  612.         print '} ' if $self->{debug__};
  613.     }
  614.  
  615.     print "\n\nPOPFile Engine ", scalar($self->CORE_version()), " running\n" if $self->{debug__};
  616.     flush STDOUT;
  617. }
  618.  
  619. #---------------------------------------------------------------------------------------------
  620. #
  621. # CORE_service
  622. #
  623. # This is POPFile. Loops across POPFile's modules and executes their service subroutines then
  624. # sleeps briefly
  625. #
  626. # $nowait            If 1 then don't sleep and don't loop
  627. #
  628. #---------------------------------------------------------------------------------------------
  629. sub CORE_service
  630. {
  631.     my ( $self, $nowait ) = @_;
  632.  
  633.     $nowait = 0 if ( !defined( $nowait ) );
  634.  
  635.     # MAIN LOOP - Call each module's service() method to all it to
  636.     #             handle its own requests
  637.  
  638.     while ( $self->{alive__} == 1 ) {
  639.         foreach my $type (keys %{$self->{components__}}) {
  640.             foreach my $name (keys %{$self->{components__}{$type}}) {
  641.                 if ( $self->{components__}{$type}{$name}->service() == 0 ) {
  642.                     $self->{alive__} = 0;
  643.                     last;
  644.                 }
  645.             }
  646.         }
  647.  
  648.         # Sleep for 0.05 of a second to ensure that POPFile does not hog the machine's
  649.         # CPU
  650.  
  651.         select(undef, undef, undef, 0.05) if !$nowait;
  652.  
  653.         # If we are on Windows then reap children here
  654.  
  655.         if ( $self->{on_windows__} ) {
  656.             foreach my $type (keys %{$self->{components__}}) {
  657.                 foreach my $name (keys %{$self->{components__}{$type}}) {
  658.                         $self->{components__}{$type}{$name}->reaper();
  659.                 }
  660.             }
  661.         }
  662.  
  663.         last if $nowait;
  664.     }
  665.  
  666.     return $self->{alive__};
  667. }
  668.  
  669. #---------------------------------------------------------------------------------------------
  670. #
  671. # CORE_stop
  672. #
  673. # Loops across POPFile's modules and stops them
  674. #
  675. #---------------------------------------------------------------------------------------------
  676. sub CORE_stop
  677. {
  678.     my ( $self ) = @_;
  679.  
  680.     print "\n\nPOPFile Engine $self->{version_string__} stopping\n" if $self->{debug__};
  681.     flush STDOUT;
  682.  
  683.     print "\n    Stopping... " if $self->{debug__};
  684.  
  685.     # Shutdown all the modules
  686.  
  687.     foreach my $type (keys %{$self->{components__}}) {
  688.         print "\n         {$type:" if $self->{debug__};
  689.         foreach my $name (keys %{$self->{components__}{$type}}) {
  690.             print " $name" if $self->{debug__};
  691.             flush STDOUT;
  692.             $self->{components__}{$type}{$name}->alive(0);
  693.             $self->{components__}{$type}{$name}->stop();
  694.         }
  695.  
  696.         print '} ' if $self->{debug__};
  697.     }
  698.     print "\n\nPOPFile Engine $self->{version_string__} terminated\n" if $self->{debug__};
  699. }
  700.  
  701. #---------------------------------------------------------------------------------------------
  702. #
  703. # CORE_version
  704. #
  705. # Gets and Sets POPFile's version data. Returns string in scalar context, or (major, minor, build)
  706. # triplet in list context
  707. #
  708. # $major_version        The major version number
  709. # $minor_version        The minor version number
  710. # $build_version        The build version number
  711. #
  712. #---------------------------------------------------------------------------------------------
  713. sub CORE_version
  714. {
  715.     my ( $self, $major_version, $minor_version, $build_version ) = @_;
  716.  
  717.     if (!defined($major_version)) {
  718.         if (wantarray) {
  719.             return ($self->{major_version__},$self->{minor_version__},$self->{build_version__});
  720.         } else {
  721.             return $self->{version_string__};
  722.         }
  723.     } else {
  724.         ($self->{major_version__}, $self->{minor_version__}, $self->{build_version__}) = ($major_version, $minor_version, $build_version);
  725.         $self->{version_string__} = "v$major_version.$minor_version.$build_version"
  726.     }
  727. }
  728.  
  729. #---------------------------------------------------------------------------------------------
  730. #
  731. # get_module
  732. #
  733. # Gets a module from components hash. Returns a handle to a module.
  734. #
  735. # May be called either as:
  736. #
  737. # $name     Module name in scoped format (eg, Classifier::Bayes)
  738. #
  739. # Or:
  740. #
  741. # $name     Name of the module
  742. # $type     The type of module
  743. #
  744. #---------------------------------------------------------------------------------------------
  745. sub get_module
  746. {
  747.     my ( $self, $name, $type ) = @_;
  748.  
  749.     if (!defined($type) && $name =~ /^(.*)::(.*)$/ ) {
  750.         $type = lc($1);
  751.         $name = lc($2);
  752.  
  753.         $type =~ s/^POPFile$/core/
  754.     }
  755.  
  756.     return $self->{components__}{$type}{$name};
  757. }
  758.  
  759. #---------------------------------------------------------------------------------------------
  760. #
  761. # set_module
  762. #
  763. # Inserts a module into components hash.
  764. #
  765. # $name     Name of the module
  766. # $type     The type of module
  767. # $module   A handle to a module
  768. #
  769. #---------------------------------------------------------------------------------------------
  770. sub set_module
  771. {
  772.     my ($self, $type, $name, $module) = @_;
  773.  
  774.     $self->{components__}{$type}{$name} = $module;
  775. }
  776.  
  777. #---------------------------------------------------------------------------------------------
  778. #
  779. # remove_module
  780. #
  781. # removes a module from components hash.
  782. #
  783. # $name     Name of the module
  784. # $type     The type of module
  785. # $module   A handle to a module
  786. #
  787. #---------------------------------------------------------------------------------------------
  788. sub remove_module
  789. {
  790.     my ($self, $type, $name) = @_;
  791.  
  792.     $self->{components__}{$type}{$name}->stop();
  793.  
  794.     delete($self->{components__}{$type}{$name});
  795. }
  796.  
  797. # ---------------------------------------------------------------------------------------------
  798. #
  799. # root_path__
  800. #
  801. # Joins the path passed in with the POPFile root
  802. #
  803. # $path             RHS of path
  804. #
  805. # ---------------------------------------------------------------------------------------------
  806. sub root_path__
  807. {
  808.     my ( $self, $path ) = @_;
  809.  
  810.     $self->{popfile_root__}  =~ s/[\/\\]$//;
  811.     $path                    =~ s/^[\/\\]//;
  812.  
  813.     return "$self->{popfile_root__}/$path";
  814. }
  815.  
  816. # GETTER/SETTER
  817.  
  818. sub debug
  819. {
  820.     my ( $self, $debug ) = @_;
  821.  
  822.     $self->{debug__} = $debug;
  823. }
  824.  
  825. sub module_config
  826. {
  827.     my ( $self, $module, $item, $value ) = @_;
  828.  
  829.     return $self->{components__}{core}{config}->module_config_( $module, $item, $value );
  830. }
  831.  
  832. 1;
  833.  
  834.